unit uModuleHistory;

{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, DB, sqldb, URIParser, dateutils, variants,
    sqlite3conn,
    uInterfaces, uTypesData;

type
    TModuleCommandHistory = (
        mchAdd      // Add new record
        );

    { THistoryDataset }

    THistoryDataset = class(TSQLQuery)
    private
        FFieldID: TField;
        FFieldFullAddress: TField;
        FFieldHost: TField;
        FFieldDoc: TField;
        FFieldParams: TField;
        FFieldTitle: TField;
        FFieldTime: TField;
        function GetFullAddress: string;
        function GetID: DWord;
        procedure SetFullAddress(AValue: string);
        procedure SetID(AValue: DWord);
    protected
        procedure DoAfterOpen; override;
    public
        property ID: DWord read GetID write SetID;
        property FullAddress: string read GetFullAddress write SetFullAddress;
    end;

    PHistoryRecord = ^THistoryRecord;

    THistoryRecord = record
        id: QWord;
        full_address: string;
        host: string;
        doc: string;
        params: string;
        title: string;
        datetime: TDateTime;
    end;

    { TModuleHistory }

    TModuleHistory = class(TISInterfacedObject, IISModule)
    private
        FCore: IISCore;
        FConnection: TSQLConnection;
        FTransaction: TSQLTransaction;
        FQueryAdd: TSQLQuery;

        FPanelTree: IISDataTree;
    protected
        // IISModule
        // -------------------------------------------------
        function GetCode: string;

        procedure Init(ACore: IISCore);
        procedure Done;

        function GetPanel: IISPanel;
        function GetFrame: IISFrameContainer;

        function ExecuteCommand(const ACmd: string; AParams: array of Pointer): string;

        procedure RefreshPanelInternal;

        // -------------------------------------------------
        function StrToCommand(const AStr: string): TModuleCommandHistory;
        procedure Execute(const AQuery: string; AParams: array of const);
        procedure CreateDatabase;
        function Select(const AQuery: string; AParams: array of const; const AOpen: boolean = False): TSQLQuery;
    public
        constructor Create;
        destructor Destroy; override;

        procedure Add(const aURL, aTitle: string);
        function GetTree(const AMonth, ADay, AHour, AHost: boolean): TSQLQuery;
    end;

var
    ModuleHistory: TModuleHistory;

implementation

uses
    LazUTF8;

{ TModuleHistory }

function TModuleHistory.GetCode: string;
begin
    Result := 'history';
end;

procedure TModuleHistory.Init(ACore: IISCore);
begin
    FCore := ACore;

    FConnection := FCore.GetDBConnection;
    FTransaction := TSQLTransaction.Create(nil);
    FConnection.Transaction := FTransaction;
    FQueryAdd := TSQLQuery.Create(nil);
    FQueryAdd.DataBase := FConnection;
    FQueryAdd.SQL.Add('insert into data');
    FQueryAdd.SQL.Add('(full_address, host, doc, params, title, datetime,');
    FQueryAdd.SQL.Add('dt_year, dt_month, dt_day, dt_hour, dt_minute, dt_second)');
    FQueryAdd.SQL.Add('values');
    FQueryAdd.SQL.Add('(:full_address, :host, :doc, :params, :title, :datetime,');
    FQueryAdd.SQL.Add(':dt_year, :dt_month, :dt_day, :dt_hour, :dt_minute, :dt_second)');
    FQueryAdd.SQL.Add('');
    FConnection.DatabaseName := './data/history.s3db';
    FConnection.Open;

    FPanelTree := TISDataTree.Create;
end;

procedure TModuleHistory.Done;
begin
    (FPanelTree as TISDataTree).Free;
end;

function TModuleHistory.GetPanel: IISPanel;
begin
    Result := nil;
end;

function TModuleHistory.GetFrame: IISFrameContainer;
begin
    Result := nil;
end;

function TModuleHistory.ExecuteCommand(const ACmd: string;
    AParams: array of Pointer): string;
var
    cmd: TModuleCommandHistory;
    s1, s2: string;
begin
    cmd := StrToCommand(ACmd);

    case cmd of
        mchAdd:
        begin
            s1 := string(AParams[0]^);
            s2 := string(AParams[1]^);
            Add(s1, s2);
        end;
    end;
end;

procedure TModuleHistory.RefreshPanelInternal;
begin
    // Cleanup tree
    // Open dataset
    // Fill tree
end;

function TModuleHistory.StrToCommand(const AStr: string): TModuleCommandHistory;
begin
    case AStr of
        'add':
            Result := mchAdd;
        else
            raise Exception.Create(Format('Module %s: unknown command %s', ['History', AStr]));
    end;
end;

procedure TModuleHistory.Execute(const AQuery: string; AParams: array of const);
var
    q: TSQLQuery;
begin
    q := TSQLQuery.Create(nil);
    try
        q.DataBase := FConnection;
        q.SQL.Text := Format(AQuery, AParams);
        q.ExecSQL;
    finally
        q.Free;
    end;
end;

procedure TModuleHistory.CreateDatabase;
begin

end;

function TModuleHistory.Select(const AQuery: string; AParams: array of const; const AOpen: boolean): TSQLQuery;
begin
    Result := TSQLQuery.Create(nil);
    try
        Result.DataBase := FConnection;
        Result.SQL.Text := Format(AQuery, AParams);
        if AOpen then
            Result.Open;
    except
        Result.Free;
        raise;
    end;
end;

constructor TModuleHistory.Create;
begin
    //WriteLn('foo');
end;

destructor TModuleHistory.Destroy;
begin
    FConnection.Close(False);
    FQueryAdd.Free;
    FConnection.Free;
    FTransaction.Free;
    inherited Destroy;
end;

procedure TModuleHistory.Add(const aURL, aTitle: string);
var
    uri: TURI;
    dt: TDateTime;
    yy, mm, dd, hh, mi, ss, ms: word;
begin
    uri := ParseURI(aURL);
    with FQueryAdd do
    begin
        dt := Now;
        DecodeDateTime(dt, yy, mm, dd, hh, mi, ss, ms);
        ParamByName('full_address').AsString := aURL;
        ParamByName('host').AsString := uri.Host;
        ParamByName('doc').AsString := uri.Document;
        ParamByName('params').AsString := uri.Params;
        ParamByName('title').AsString := aTitle;
        ParamByName('datetime').AsDateTime := Now;
        ParamByName('dt_year').AsInteger := yy;
        ParamByName('dt_month').AsInteger := mm;
        ParamByName('dt_day').AsInteger := dd;
        ParamByName('dt_hour').AsInteger := hh;
        ParamByName('dt_minute').AsInteger := mi;
        ParamByName('dt_second').AsInteger := ss;
        ExecSQL;
        FTransaction.CommitRetaining;
    end;
end;

function TModuleHistory.GetTree(const AMonth, ADay, AHour, AHost: boolean): TSQLQuery;
var
    flds: string;
    sql: string;
begin
    flds := '';
    if AMonth then
        flds := 'dt_month';
    if ADay then
    begin
        if flds <> '' then
            flds := flds + ', ';
        flds := flds + 'dt_day';
    end;
    if AHour then
    begin
        if flds <> '' then
            flds := flds + ', ';
        flds := flds + 'dt_hour';
    end;
    if AHost then
    begin
        if flds <> '' then
            flds := flds + ', ';
        flds := flds + 'host';
    end;

    sql := 'select distinct dt_year';
    if flds <> '' then
        sql := sql + ', ' + flds;
    sql := sql + ' from data order by datetime desc';
    if AHost then
        sql := sql + ', host';

    Result := Select(sql, []);
end;

{ THistoryDataset }

function THistoryDataset.GetFullAddress: string;
begin
    Result := FFieldFullAddress.AsString;
end;

function THistoryDataset.GetID: DWord;
begin
    Result := FFieldID.AsInteger;
end;

procedure THistoryDataset.SetFullAddress(AValue: string);
begin
    FFieldFullAddress.AsString := AValue;
end;

procedure THistoryDataset.SetID(AValue: DWord);
begin
    FFieldID.AsInteger := AValue;
end;

procedure THistoryDataset.DoAfterOpen;
begin
    inherited DoAfterOpen;
    FFieldID := FindField('id');
    FFieldFullAddress := FindField('full_address');
    FFieldHost := FindField('host');
    FFieldDoc := FindField('doc');
    FFieldParams := FindField('params');
    FFieldTitle := FindField('title');
    FFieldTime := FindField('datetime');
end;

end.





